home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / RSC_GET.M < prev    next >
Encoding:
Text File  |  1991-02-08  |  4.9 KB  |  193 lines
  1. MODULE Rsc_Get;
  2.  
  3. (*
  4.  * Entwickelt unter Megamax Modula-2 V2.2
  5.  *
  6.  * Linken: Als Treiber wird lediglich M2Init benötigt.
  7.  *)
  8.  
  9. FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, BYTE, WORD, ADR;
  10. FROM Characters IMPORT CR, LF, EOF;
  11. FROM Console IMPORT Write, WriteLn, WriteString, FlushKbd, Read;
  12. FROM Files IMPORT File, Create, Close, State, Access, ReplaceMode, ResetState,
  13.         GetStateMsg, Remove;
  14. FROM Binary IMPORT WriteBlock, WriteBytes;
  15. FROM Storage IMPORT ALLOCATE;
  16. FROM SysUtil1 IMPORT BPeek, WPeek, LPeek, SuperLPeek, SuperWPeek;
  17. FROM SysInfo IMPORT GetTOSVersion;
  18. FROM MOSGlobals IMPORT FileStr, Date;
  19. FROM GEMEnv IMPORT InitApplication, ExitApplication;
  20. FROM EasyGEM0 IMPORT ShowMouse, HideMouse;
  21. FROM EasyGEM1 IMPORT SelectFile;
  22. IMPORT VT52;
  23. IMPORT Block;
  24.  
  25. CONST   RscPrgName   = "RSCPATCH.PRG";
  26.         DataFileName = "DESKTOP.DAT";
  27.  
  28.  
  29. PROCEDURE FindStr (REF text: ARRAY OF CHAR; start: ADDRESS; len: LONGCARD;
  30.                    VAR addr: ADDRESS): BOOLEAN;
  31.   VAR found: BOOLEAN;
  32.   BEGIN
  33.     found:= FALSE;
  34.     addr:= NIL;
  35.     ASSEMBLER
  36.         MOVE.L  start(A6),A1
  37.         MOVE.L  len(A6),D1
  38.         MOVE.L  text(A6),A0
  39.         MOVE.B  (A0)+,D2
  40.         BNE     los
  41.         BRA     ende
  42.      l1 SWAP    D1
  43.      l2 CMP.B   (A1)+,D2
  44.     los DBEQ    D1,l2
  45.         BEQ     f1
  46.         SWAP    D1
  47.         DBRA    D1,l1
  48.         BRA     ende
  49.      f1 MOVE.L  A1,A2
  50.         MOVE.W  text+4(A6),D0
  51.         BEQ     hurra
  52.         SUBQ    #1,D0
  53.      f2 MOVE.B  (A0)+,D2
  54.         BEQ     hurra
  55.         CMP.B   (A1)+,D2
  56.         DBNE    D0,f2
  57.         BEQ     hurra
  58.         MOVE.L  A2,A1
  59.         MOVE.L  text(A6),A0
  60.         MOVE.B  (A0)+,D2
  61.         BRA     los
  62.       hurra
  63.         MOVE.L  start(A6),A0
  64.         ADDA.L  len(A6),A0
  65.         CMPA.L  A0,A1
  66.         BHI     ende
  67.         ADDQ    #1,found(A6)
  68.         MOVE.L  addr(A6),A0
  69.         SUBQ.L  #1,A2
  70.         MOVE.L  A2,(A0)
  71.       ende
  72.     END;
  73.     RETURN found
  74.   END FindStr;
  75.  
  76. PROCEDURE wait;
  77.   VAR ch: CHAR;
  78.   BEGIN
  79.     WriteLn;
  80.     WriteLn;
  81.     WriteString ("Press a key... ");
  82.     FlushKbd;
  83.     Read (ch)
  84.   END wait;
  85.  
  86. PROCEDURE writeHeader;
  87.   BEGIN
  88.     WriteString (VT52.Seq[VT52.clearScreen]);
  89.     WriteLn;
  90.     WriteLn;
  91.     WriteString ("RSC-Get for RSCPatch by proVME");
  92.     WriteLn;
  93.     WriteLn;
  94.   END writeHeader;
  95.  
  96. TYPE  FileHeader = RECORD
  97.         ident: ARRAY [0..15] OF CHAR; (* "MM2/RscPatch"+CR+LF+EOF *)
  98.         version: BYTE;     (* = 1 *)
  99.         revision: BYTE;    (* = 0 *)
  100.         rscOffs: LONGCARD; (* = 36 *)
  101.         reserved: ARRAY [1..3] OF LONGCARD;
  102.         conf: WORD;
  103.       END;
  104.  
  105. VAR ok: BOOLEAN;
  106.     date: Date;
  107.     version, revision: CARDINAL;
  108.     buffer, rscAddr: ADDRESS;
  109.     rscSize: CARDINAL;
  110.     head: FileHeader;
  111.  
  112. PROCEDURE stateOK (VAR f: File): BOOLEAN;
  113.   VAR s: ARRAY [0..79] OF CHAR;
  114.   BEGIN
  115.     IF State (f) >= 0 THEN
  116.       RETURN TRUE
  117.     ELSE
  118.       WriteString ("Error: ");
  119.       GetStateMsg (State (f), s);
  120.       WriteString (s);
  121.       ResetState (f);
  122.       Remove (f);
  123.       wait;
  124.       RETURN FALSE
  125.     END
  126.   END stateOK;
  127.   
  128.  
  129. PROCEDURE writeFile;
  130.   VAR f: File; ok: BOOLEAN; fname: FileStr;
  131.   BEGIN
  132.     fname:= "A:\"+DataFileName;
  133.     INC (fname[0], SuperWPeek ($446)); (* set letter of boot drive *)
  134.     ShowMouse;
  135.     SelectFile ("Write "+DataFileName, fname, ok);
  136.     HideMouse;
  137.     writeHeader;
  138.     IF ok THEN
  139.       Create (f, fname, writeOnly, replaceOld);
  140.       IF NOT stateOK (f) THEN RETURN END;
  141.       WriteBlock (f, head);
  142.       IF NOT stateOK (f) THEN RETURN END;
  143.       WriteBytes (f, buffer, rscSize);
  144.       IF NOT stateOK (f) THEN RETURN END;
  145.       Close (f);
  146.       IF NOT stateOK (f) THEN RETURN END;
  147.       WriteString ("File ");
  148.       WriteString (fname);
  149.       WriteString (" successfully written.");
  150.       WriteLn;
  151.       WriteLn;
  152.       WriteString ('Now place "'+RscPrgName+'" into your AUTO folder and reboot.');
  153.       wait
  154.     END
  155.   END writeFile;
  156.  
  157. BEGIN
  158.   InitApplication (ok);
  159.   HideMouse;
  160.   writeHeader;
  161.   GetTOSVersion (version, revision, date);
  162.   IF (version # 1) OR (revision # 4) THEN
  163.     WriteString ("You must run this program under TOS 1.4!");
  164.     wait
  165.   ELSIF NOT FindStr ("able to inst", SuperLPeek ($4F2), $30000, rscAddr) THEN
  166.     WriteString ("Unable to locate the resource in ROM!");
  167.     wait
  168.   ELSE
  169.     WHILE BPeek (rscAddr) # 0 DO INC (rscAddr) END;
  170.     INC (rscAddr);
  171.     IF ODD (rscAddr) THEN INC (rscAddr) END;
  172.     (* 'rscAddr' now points to start of RSC/INF block *)
  173.     rscSize:= WPeek (rscAddr+4);
  174.     ALLOCATE (buffer, rscSize);
  175.     IF buffer = 0 THEN
  176.       WriteString ("Out of memory");
  177.       wait
  178.     ELSE
  179.       Block.Copy (rscAddr, rscSize, buffer);
  180.       WITH head DO
  181.         ident:= "MM2/RscPatch"+CR+LF+EOF;
  182.         version:= SHORT (1);
  183.         revision:= SHORT (0);
  184.         rscOffs:= SIZE (head);
  185.         conf:= WORD (WPeek (SuperLPeek ($4F2)+$1C))
  186.       END;
  187.       writeFile
  188.     END
  189.   END;
  190.   ShowMouse;
  191.   ExitApplication
  192. END Rsc_Get.
  193.